(defmeth missing-data-model-object-proto :visualize-patterns ()
  (setf patterns-plots (make-container :free t :type 1 :local-menus t :show nil))
  (enable-container patterns-plots)
  (let* (
         (non-nil-patterns (which (mapcar #'(lambda (pat)
                                              (not (equal (remove-duplicates 
                                                           (coerce pat 'list)) '(0))))
                                          (send self :patterns-missing)))) 
         (patterns-list (mapcar #'(lambda (pat)
                              (coerce pat 'list))
                           (select (send self :patterns-missing) non-nil-patterns)))
         (var-missing (mapcar #'(lambda (pat) 
                                  (select (send self :variables)
                                          (which (mapcar #'(lambda (val) 
                                                             (= val 0))
                                                         pat))))
                              patterns-list))
         (patterns-labels (mapcar #'(lambda (val) 
                                      (if val
                                          (first (introduce-symbol (coerce val 'list) " "))
                                          "Complete Data"))
                                  var-missing))
         (plot-mcar (send self :plot-mcar-means-test))
         (patterns-plot (send self :patterns-plot))
         (patterns-name (name-list patterns-labels :title "Patterns" ))
         )

    (send patterns-name :point-color (iseq (length patterns-labels)) 'blue)
    
    (spread-plot (matrix (list 2 3) (list patterns-name plot-mcar  nil patterns-plot nil nil))
                 :local-links t
                 :container patterns-plots
                 :span-down (matrix '(2 3) (list 1 1 1 1 1 1 ))
                 :span-right (matrix '(2 3) (list 1 2 0 3 0 0))
                 :show t)
    (mapcar #'(lambda (plot) (send plot :linked t)) (list plot-mcar patterns-plot patterns-name))
    (disable-container)))



(defmeth missing-data-model-object-proto :plot-MCAR-means-test ()
  (let* (
         (data (send self :data))
         (em-means (send self :em-means))
         (em-covars (send self :emcovariance))
         (N (array-dimension data 0))
         (nvars (array-dimension data 1))
         (ci (/ (mapcar 'length (send self :cases-by-missing-pattern)) N))
         (observed-by-pattern
          (mapcar #'(lambda (miss-pattern) 
                      (which (map-elements #'equalp 1 (coerce miss-pattern 'list))))
                  (send self :patterns-missing)))
         (missing-by-pattern (mapcar #'(lambda (m) (sort-data (set-difference (iseq nvars) m))
                                         )
                                     observed-by-pattern))
         (n-by-pattern (mapcar 'length (send self :cases-by-missing-pattern)))
         (means-observed-by-pattern
          (mapcar #'(lambda (cases-in-pattern vars-in-pattern) 
                      (mapcar #'(lambda (var)
                                  (mean var))
                              (column-list 
                               (select data
                                       cases-in-pattern 
                                       vars-in-pattern ))))        
                  (send self :cases-by-missing-pattern) observed-by-pattern))
         (number-of-means (length (combine means-observed-by-pattern)))
         (means-imputed-by-pattern
          (mapcar #'(lambda (vars-in-pattern) 
                      (select em-means vars-in-pattern))
                  observed-by-pattern))
         (covars-imputed-by-pattern            
          (mapcar #'(lambda (vars-in-pattern) 
                      (select em-covars vars-in-pattern vars-in-pattern))
                  observed-by-pattern))
         (covars-imputed-by-pattern-ajj            
          (mapcar #'(lambda (vars-in-pattern) 
                      (setf em-cov (copy-array em-covars))
                      (setf (select em-cov vars-in-pattern vars-in-pattern)
                            (make-array (list (length vars-in-pattern) (length vars-in-pattern)) :initial-element 0))
                      em-cov)
                  missing-by-pattern))
         (covars-imputed-by-pattern-Aj 
          (mapcar #'(lambda (vars-in-pattern) 
                      (setf em-cov (copy-array em-covars))
                      (setf (select em-cov (iseq nvars)  vars-in-pattern ) 
                             (make-array (list nvars (length vars-in-pattern)) :initial-element 0))
                      em-cov)
                  missing-by-pattern))
         
         (aj (mapcar #'(lambda (n aj ajj) (matmult (/ n N)  aj (inverse ajj)))
                     n-by-pattern
                     covars-imputed-by-pattern-aj
                     covars-imputed-by-pattern-ajj))


       #|  (covars-imputed-by-pattern-ajj            
          (mapcar #'(lambda (vars-in-pattern) 
                      (select em-covars (iseq nvars) vars-in-pattern))
                  observed-by-pattern))
         (aj (mapcar #'(lambda (n ajj aj) (matmult (/ n N)  aj (inverse ajj)))
                     n-by-pattern
                     covars-imputed-by-pattern
                     covars-imputed-by-pattern-ajj))
         
         (means-observed-by-pattern (repeat 0 2))
         (u (mapcar #'(lambda (a m) (matmult (inverse aj) (matmult m a ))) aj means-observed-by-pattern))
         (sumaj (sum (combine aj)))
         (u (/ u sumaj))
         (u (mapcar #'(lambda (s m) (/ (select em-means s) m))
                        observed-by-pattern means-observed-by-pattern))|#
         (u (mapcar #'(lambda (pj) (/ (-  nvars pj) pj)) (mapcar 'length observed-by-pattern)))
         

       #|  (d2 (mapcar #'(lambda 
                        (* (/ n-by-pattern N) 
                    ;ci 
                    n-by-pattern
                    means-observed-by-pattern
                    means-imputed-by-pattern
                    covars-imputed-by-pattern))|#
         (d (mapcar #'(lambda 
                        (prop means-obs means-imput covar-imput)           
                        (matmult prop (- means-obs means-imput) 
                                 (inverse covar-imput)
                                 (- means-obs means-imput)))
                    ;ci 
                    n-by-pattern
                    means-observed-by-pattern
                    means-imputed-by-pattern
                    covars-imputed-by-pattern))
        (d (mapcar #' (lambda (dj vj) (/ dj vj)) d 
                    (mapcar #'length means-observed-by-pattern)));normalize d
         (sc (scatterplot n-by-pattern d))
                       
         )
               (print u)
               
    (send sc :mouse-mode 'selecting)
    (send sc :range '0 0 (second (send sc :range '0)))
    sc
    ))




(defmeth missing-data-model-object-proto :patterns-plot()
  (let* (
         (data-imputed (send self :imputed-data-normal))
         (norm-data-imputed (normalize (center data-imputed)))
         (data-original-means-sd 
          (apply 'bind-columns
                 (mapcar #'(lambda (var var-imp) 
                      (setf nm (non-missing var))
                      (/ (- var-imp (mean nm))
                            (standard-deviation nm)))
                  (column-list (send self :data))
                  (column-list data-imputed))))
                                           
         (non-nil-patterns (which (mapcar #'(lambda (pat)
                                              (not (equal (remove-duplicates 
                                                           (coerce pat 'list)) '(0))))
                                          (send self :patterns-missing))))
         (patterns (select (send self :patterns-missing) non-nil-patterns))                       
         (cases-by-pattern (send self :cases-by-missing-pattern))
         (means-by-pattern (mapcar 
                            #'(lambda (var)
                                (mapcar 
                                 #'(lambda (patt) 
                                     (mean (select var patt)))
                                 cases-by-pattern))
                            (column-list data-imputed)))
         (means-by-pattern-normalized (mapcar 
                                       #'(lambda (var)
                                           (mapcar 
                                            #'(lambda (patt) 
                                                (mean (select var patt)))
                                            cases-by-pattern))
                                       (column-list norm-data-imputed)))
         (sd-by-pattern 
          (mapcar #'(lambda (var)
                      (mapcar #'(lambda (patt) 
                                  (setf res (if (variancep (select var patt))
                                                (standard-deviation (select var patt))
                                                0)))
                              cases-by-pattern))
                  (column-list data-imputed)))
         (sd-by-pattern-normalized 
          (mapcar #'(lambda (var)
                      (mapcar #'(lambda (patt) 
                                  (setf res (if (variancep (select var patt))
                                                (standard-deviation (select var patt))
                                                0)))
                              cases-by-pattern))
                  (column-list norm-data-imputed)))
         (n-by-pattern (mapcar 
                        #'(lambda (var)
                            (mapcar 
                             #'(lambda (patt) 
                                 (setf res (length (select var patt)))
                                 (if res res 0.001))
                             cases-by-pattern))
                        (column-list data-imputed)))
         (variables (send self :variables))
         (pt-missing (which (mapcar #'(lambda (val) 
                                        (= val 0)) 
                                    (combine (apply 'bind-columns patterns)))))
         (shapes (let* (
                        (list-diamonds (repeat 'diamond (iseq (length (combine means-by-pattern)))))
                        (res (setf (select list-diamonds pt-missing) (repeat 'circle (length pt-missing)))))
                   list-diamonds))
         (patterns-list (mapcar #'(lambda (pat) 
                                    (coerce pat 'list))
                                patterns))
         (var-missing (mapcar #'(lambda (pat) 
                                  (select variables
                                          (which (mapcar #'(lambda (val) 
                                                             (= val 0))
                                                         pat))))
                              patterns-list))
         (patterns-labels (mapcar #'(lambda (val) 
                                      (princ-to-string (coerce val 'list)))
                                  var-missing))
        #| (better-range-normalized 
          (list (min (mapcar #'(lambda (var)
                                 (quantile var .1))
                             (column-list norm-data-imputed)))
                (max (mapcar #'(lambda (var)
                                 (quantile var .9))
                             (column-list norm-data-imputed)))))
         (better-range-normalized-no-box
          (list (min (mapcar #'(lambda (var)
                                 (quantile var .25))
                             (column-list norm-data-imputed)))
                (max (mapcar #'(lambda (var)
                                 (quantile var .75))
                             (column-list norm-data-imputed)))))
         (better-range
          (list (min (mapcar #'(lambda (var)
                                 (quantile var .1))
                             (column-list data-imputed)))
                (max (mapcar #'(lambda (var)
                                 (quantile var .9))
                             (column-list data-imputed)))))
         (better-range-no-box
          (list (min (mapcar #'(lambda (var)
                                 (quantile var .25))
                             (column-list data-imputed)))
                (max (mapcar #'(lambda (var)
                                 (quantile var .75))
                             (column-list data-imputed)))))|#
         (bx (boxplot means-by-pattern
                      :variable-labels variables
                      :point-labels patterns-labels
                      :connect-points t
                      :equate t
                      :jitter nil
                      ))
         )





    (defmeth bx :isnew (&rest args)
      (call-next-method args))

    (send (send bx :menu) :delete-items (select (send (send bx :menu) :items) 9));change color of points is not allowed

    (defmeth bx :prepare-width (values-by-pattern)
      (let* (
             (range (abs (apply '- (send self :range 0))))
             (num-var (send self :num-var))
             (space-by-var (/ (/ range num-var) 2))
             (values-by-pattern values-by-pattern)
             (n (sum (first values-by-pattern)))
             (max-horizontal 5)
             )
        (mapcar #'(lambda (vals)
                    (* (/ vals n) space-by-var))
                values-by-pattern)
        ))
    
    (send bx :point-color pt-missing 'red)
    (send bx :title "Description of Patterns")
    (send bx :y-axis-label "Means by Pattern") 
    (send bx :connect-points t)
    (send bx :mouse-mode 'selecting)
    (send bx :point-symbol (iseq (send bx :num-points)) 'diamond)
    (send bx :boxes nil)
    (send bx :diamonds t)
    (symbol :plot bx :type 'diamonds  
            :heigths (combine sd-by-pattern-normalized)
            :widths (combine (send bx :prepare-width (repeat n-by-pattern (send bx :num-var))))
            :shapes shapes
            :modify-methods t) ;I have not modified redraw, adjust screen or adjust-screen-point so fine
    (defmeth bx :parallel (pti s num-obs num-var &optional mouse-mode)
      "Args: PTI S
Draws parallel boxplot connecting lines for points PTI. If S is 'NORMAL, erases lines by drawing in background color. Uses self mouse-mode when MOUSE-MODE is nil, another windows MOUSE-MODE when not nil."
      ; (format t "BP: Parallel~d~%"(list pti s))
      (when (not mouse-mode) (setf mouse-mode (send self :mouse-mode)))
      (cond 
        (pti
         (let* (
                
                ;(junk (break))
                (data (if (send self :equate)
                          (send self :normed-data)
                          (send self :data)))
                (pt (mod pti num-obs))
                (draw-color (send self :draw-color))
                (back-color (send self :back-color))
                (line-color nil)
                (color-on? (and (send (send self :button-overlay) :color-mode) 
                                (> *color-mode* 0)))
                (ptnow nil))
           (dotimes (i (length pt))
                    (setf ptnow (select pt i))
                    (when color-on?
                          (setf line-color 'blue) ; was (send self :point-color ptnow)) changed to avoid problems PV
                          (if (not line-color) (setf line-color 'black))
                          (if (eq s 'normal) (setf line-color back-color)))
                    (send self :add-lines 
                          (send self :point-coordinate 0 
                                (rseq ptnow 
                                      (+ ptnow (* (- num-var 1) num-obs)) num-var))
                          (send self :point-coordinate 1 
                                (rseq ptnow 
                                      (+ ptnow (* (- num-var 1) num-obs)) num-var))
                          :color line-color
                          ))
           (when (not (or (send self :diamonds) (send self :boxes)))
                 (when (send self :showing-labels) (send self :add-labels)))
           ))
        (t 
         (when (eq mouse-mode 'selecting) (send self :change-plot))
         )))

  (defmeth bx :show-all-points ()
    (call-next-method)
    (send self :change-plot))

    
    (defmeth bx :change-plot ()
      (let* (
             (normalized (send self :equate))
             (data (column-list (if (send self :equate) 
                       data-original-means-sd
                       data-imputed)))
             (num-lines-b4 nil)
         
             (color? (and (send (send self :button-overlay) :color-mode)  
                          (> *color-mode* 0)))
             (width (if color? 2 1))
             (n (mapcar #'length data))
             (x (send self :x)))
        (send self :start-buffering)
        (send self :clear-lines)
        (when (send self :equate)
              (mapcar #'(lambda (coord) 
                          (send self :add-lines (send self :range '0) (combine coord)
                                :color 'cyan
                                :type 'dashed))
                      (list (list 0 0) (list (list 1 1)) (list -1 -1))))
        (dotimes (i (length data))
                 (when (send self :boxes)
                       (send self :add-boxplot (nth i data) 
                             :width (round (/ (/ (abs (apply '- (send self :range '0))) (send self :num-var)) 2))
                             ;1
                             ; (/ (nth i n) 2)  
                             :color 'violet
                             :lwidth 1
                             :x (nth i x)))
                 (when (send self :diamonds)
                       (send self :add-diamondplot (nth i data) 
                             :width (round (/ (/ (abs (apply '- (send self :range '0))) (send self :num-var)) 2))
                             ;1
                             ;(/ (nth i n) 2) 
                             :color 'orange
                             :lwidth 1
                             :x (nth i x))))
                    
        (when (send self :median-line)
              (setf num-lines-b4 (send self :num-lines))
              (send self :add-lines x (mapcar #'median data) 
                    :color (if color? 'violet 'black)
                    :width 1))
        (when (send self :mean-line)
              (setf num-lines-b4 (send self :num-lines))
              (send self :add-lines x (mapcar #'mean data) 
                    :color (if color? 'orange 'black)
                    :width 1))
        (setf showing-means 
              (select (if (send self :equate)
                          (combine means-by-pattern-normalized) 
                          (combine means-by-pattern))
                      (which (send self :point-showing 
                                   (iseq (send self :num-points))))))
        (setf ranges-1 
              (cond 
                ((send self :boxes)
                 (list (min (combine showing-means (map-elements 'quantile data .10)))
                       (max (combine showing-means (map-elements 'quantile data .90)))))
                ((send self :diamonds)
                 (setf sds (mapcar 'standard-deviation data))
                 (setf ms (mapcar 'mean data))
                 (list (min (combine  (- ms sds) showing-means))
                       (max (combine  (+ ms sds) showing-means))))
                 (t (list (min (combine showing-means))
                          (max (combine showing-means))))
                 ))

        (when (send self :equate) 
              (if (> (first ranges-1) -1)
                  (setf (select ranges-1 0) -1))
              (if (< (second ranges-1) 1)
                  (setf (select ranges-1 1) 1)))

        (send self :range '1 (first ranges-1) (second ranges-1))
        (send bx :point-color (iseq (send self :num-points)) 'blue)
        (send bx :point-color pt-missing 'red)
        (send bx :point-symbol (iseq (send self :num-points)) 'diamond)
        (send bx :point-symbol pt-missing 'X)
        (send self :redraw)
        (send self :buffer-to-screen)
        ))

    (defmeth bx :normalize (data)
      means-by-pattern-normalized)
    (send bx :start-buffering) ;ugly. This makes to update the plots so it uses correct
    (send bx :switch-equate);normalized data
    (send bx :switch-equate)
    (send bx :buffer-to-screen)
  bx
    
    ))

;(send current-model :visualize-patterns)